home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / imb9101.zip / GETKEY.BAS < prev    next >
BASIC Source File  |  1990-12-31  |  3KB  |  151 lines
  1. DECLARE FUNCTION IsSpecialKey% (KeyCode%)
  2. DECLARE FUNCTION GetKey% ()
  3. DECLARE FUNCTION UngetKey% (KeyCode%)
  4.  
  5. 'Program==GETKEY.BAS==Functions to let you get keys from
  6. '         the keyboard, even arrows and function keys.
  7. '         Includes a keypress pushback mechanism.
  8.  
  9. DEFINT A-Z
  10.  
  11. CLS
  12.  
  13. CONST MaxKeys = 16
  14. DIM SHARED UgkIdx%, True%, False%, UgkBuf(MaxKeys)
  15.  
  16. UgkIdx = 0
  17. True% = -1
  18. False% = 0
  19.  
  20. 'Definitions for special keys
  21.  
  22. CONST Null = 0
  23. CONST kF1 = 315
  24. CONST kF2 = 316
  25. CONST kF3 = 317
  26. CONST kF4 = 318
  27. CONST kF5 = 319
  28. CONST kF6 = 320
  29. CONST kF7 = 321
  30. CONST kF8 = 322
  31. CONST kF9 = 323
  32. CONST kF10 = 324
  33.  
  34. CONST kHome = 327
  35. CONST kEnd = 335
  36. CONST kPgUp = 329
  37. CONST kPgDn = 337
  38. CONST kIns = 338
  39. CONST kDel = 339
  40. CONST kUp = 328
  41. CONST kDown = 336
  42. CONST kleft = 331
  43. CONST kRight = 333
  44.  
  45. CONST kEnter = 13
  46. CONST kEsc = 27
  47.  
  48.  
  49. '** Demonstration of the GetKey routines ************************
  50.  
  51. '**** Pushback the message "Bob!"
  52.  
  53.   A% = UngetKey%(ASC("!"))
  54.   A% = UngetKey%(ASC("b"))
  55.   A% = UngetKey%(ASC("o"))
  56.   A% = UngetKey%(ASC("B"))
  57.  
  58.   WHILE I <> kEnd
  59.  
  60.     I = GetKey%
  61.  
  62.     SELECT CASE I
  63.       CASE Null
  64.       CASE kF1
  65.         PRINT "<F1>"
  66.       CASE kPgUp
  67.         PRINT "<PgUp>"
  68.       CASE kEnd
  69.         PRINT "<End>"
  70.       CASE kEnter
  71.         PRINT "<Enter>"
  72.       CASE kEsc
  73.         PRINT "<Esc>"
  74.       CASE ELSE
  75.         IF IsSpecialKey%(I) THEN
  76.           PRINT USING "[###]"; I
  77.         ELSE
  78.           PRINT CHR$(I)
  79.         END IF
  80.     END SELECT
  81.  
  82.   WEND
  83.  
  84. END
  85.  
  86. FUNCTION GetKey%
  87.  
  88. '****************************************************************
  89. '** GetKey - Get a key from the keyboard (or Unget buffer if   **
  90. '**          it's not empty).                                  **
  91. '** Output - Value of next available key                       **
  92. '****************************************************************
  93.  
  94. '** Return a key that has be Ungotten, if one's there
  95.  
  96.   IF UgkIdx > 0 THEN
  97.  
  98.     GetKey% = UgkBuf(UgkIdx)
  99.     UgkIdx = UgkIdx - 1
  100.  
  101.   ELSE
  102.  
  103.     C$ = INKEY$
  104.  
  105.     IF LEN(C$) = 0 THEN
  106.       GetKey% = 0
  107.     ELSEIF LEN(C$) = 1 THEN
  108.       GetKey% = ASC(C$)
  109.     ELSEIF LEN(C$) = 2 THEN
  110.       GetKey% = 256 + ASC(RIGHT$(C$, 1))
  111.     END IF
  112.  
  113.   END IF
  114.  
  115. END FUNCTION
  116.  
  117. FUNCTION IsSpecialKey% (KeyCode%)
  118.  
  119. '****************************************************************
  120. '** SpecialKey - decides if the specified value represents a **
  121. '**                special key or not. (Exm. F3, Up arrow,     **
  122. '**                Page down, etc.)                            **
  123. '** Output - True if it's a special key, otherwise False       **
  124. '****************************************************************
  125.  
  126.   IsSpecialKey% = False
  127.   IF KeyCode% > 255 OR KeyCode% < 0 THEN
  128.     IsSpecialKey% = True
  129.   END IF
  130.  
  131. END FUNCTION
  132.  
  133. FUNCTION UngetKey% (KeyCode%)
  134.  
  135. '****************************************************************
  136. '**  UngetKey - push a key back into the keyboard buffer.       *
  137. '**  Input    - KeyCode% - Key to push back                     *
  138. '**  Output   - 0 if failed, -1 if successful                   *
  139. '****************************************************************
  140.  
  141.   IF UgkIdx < MaxKeys THEN
  142.     UgkIdx = UgkIdx + 1
  143.     UgkBuf(UgkIdx) = KeyCode%
  144.     UngetKey% = True
  145.   ELSE
  146.     UngetKey% = False
  147.   END IF
  148.  
  149. END FUNCTION
  150.  
  151.